Option Compare Database
Option Explicit
Const str1 = "Provider=Microsoft.Jet.OLEDB.4.0; Data _ Source=C:\LunarSociety\OLS1.mdb;"
Const strDefaultSQL = "SELECT * FROM MEMBERS"

'Enable events
Dim WithEvents cnxn As ADODB.Connection
Dim WithEvents rst1 As ADODB.Recordset

'Connect to record source
Private Sub Form_Load()
'Connect to source specified by str1
    Set cnxn = New ADODB.Connection
    cnxn.Open str1
   
End Sub

'Retrieve a recordset
Private Sub ConnectOrRefresh_Click()
On Error GoTo Err_ConnectOrRefresh_Click
Dim strSQL As String
strSQL = strDefaultSQL

'Instantiate a recordset object
Set rst1 = New ADODB.Recordset

'Fetch the recordset and report on progress
With rst1
    .CursorLocation = adUseClient
    .Properties("Initial Fetch Size") = 2
    .Properties("Background Fetch Size") = 2
    .Open strSQL, cnxn, , , adAsyncFetch
End With

Exit_ConnectOrRefresh_Click:
    Exit Sub

Err_ConnectOrRefresh_Click:
    MsgBox Err.Description
    Resume Exit_ConnectOrRefresh_Click
   
End Sub

' Move cursor to first record and display contents
Private Sub GoToFirst_Click()
On Error GoTo Err_GoToFirst_Click

    rst1.MoveFirst

'Display First Record
DisplayCurrent

Exit_GoToFirst_Click:
    Exit Sub

Err_GoToFirst_Click:
    MsgBox Err.Description
    Resume Exit_GoToFirst_Click
   
End Sub

'Move cursor to previous record and display contents
Private Sub GoToPrevious_Click()
On Error GoTo Err_GoToPrevious_Click

    rst1.MovePrevious

'Display Previous Record
DisplayCurrent

Exit_GoToPrevious_Click:
    Exit Sub

Err_GoToPrevious_Click:
    MsgBox Err.Description
    Resume Exit_GoToPrevious_Click
   
End Sub

'Move cursor to next record and display contents
Private Sub GoToNext_Click()
On Error GoTo Err_GoToNext_Click

    rst1.MoveNext

'Display Next Record
DisplayCurrent

Exit_GoToNext_Click:
    Exit Sub

Err_GoToNext_Click:
    MsgBox Err.Description
    Resume Exit_GoToNext_Click
   
End Sub

'Move cursor to last record and display contents
Private Sub GoToLast_Click()
On Error GoTo Err_GoToLast_Click

    rst1.MoveLast

'Display Last Record
DisplayCurrent

Exit_GoToLast_Click:
    Exit Sub

Err_GoToLast_Click:
    MsgBox Err.Description
    Resume Exit_GoToLast_Click
   
End Sub

'Move cursor to selected record and display contents
Private Sub FindMember_Click()
On Error GoTo Err_FindMember_Click

'Get specified record and display info from it
rst1.Find "" & "FirstName = " & "'" & _
    txtFirstName & "'" & "", , adSearchForward, adBookmarkFirst

'Display Found Record
DisplayCurrent

Exit_FindMember_Click:
    Exit Sub

Err_FindMember_Click:
    MsgBox Err.Description
    Resume Exit_FindMember_Click
   
End Sub

Private Sub DisplayCurrent()
'Fix possible out of range condition
If rst1.BOF Then
    rst1.MoveFirst
ElseIf rst1.EOF Then
    rst1.MoveLast
End If
Me.txtFirstName = rst1("FirstName")
Me.txtLastName = rst1("LastName")
Me.txtEmail = rst1("Email")

End Sub
